home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / cml-098.lha / cml-0.9.8 / examples / ex-multicast.sml < prev    next >
Encoding:
Text File  |  1990-11-08  |  1.4 KB  |  54 lines
  1. (* ex-multicast.sml
  2.  *
  3.  * COPYRIGHT (c) 1990 by John H. Reppy.  See COPYRIGHT file for details.
  4.  *
  5.  * A multi-cast channel abstraction.
  6.  *)
  7.  
  8. (* BEGIN EXAMPLE *)
  9. functor Multicast (BC : BUFFER_CHAN) : MULTICAST =
  10.   struct
  11.     structure CML = BC.CML
  12.  
  13.     open CML
  14.  
  15.     datatype 'a mchan = MChan of ('a request chan * 'a event chan)
  16.      and 'a request = Message of 'a | NewPort
  17.  
  18.     fun mChannel () = let
  19.           val reqCh = channel() and respCh = channel()
  20.           fun mkPort outFn = let
  21.                 val buf = BC.buffer()
  22.         val inCh = channel()
  23.         fun tee () = let val m = accept inCh
  24.               in
  25.             BC.bufferSend(buf, m);
  26.             outFn m;
  27.             tee()
  28.               end
  29.                 in
  30.           spawn tee;
  31.                   (fn m => send(inCh, m), BC.bufferReceive buf)
  32.         end
  33.           fun server outFn = let
  34.                 fun handleReq NewPort = let val (outFn', port) = mkPort outFn
  35.                       in
  36.                         send (respCh, port);
  37.                         outFn'
  38.                       end
  39.                   | handleReq (Message m) = (outFn m; outFn)
  40.                 in
  41.                   server (sync (wrap (receive reqCh, handleReq)))
  42.                 end
  43.           in
  44.             spawn (fn () => server (fn _ => ()));
  45.             MChan(reqCh, respCh)
  46.           end
  47.  
  48.     fun newPort (MChan(reqCh, respCh)) = (send (reqCh, NewPort); accept respCh)
  49.  
  50.     fun multicast (MChan(ch, _), m) = send (ch, Message m)
  51.  
  52.   end (* Multicast *)
  53. (* END EXAMPLE *)
  54.